stazsoftware.com/www.stazsoftware.com.tar/www.stazsoftware.com/futurebasic/sample-code/DBFD.sit/DBFD2.0/DataBrowser With Toolbox/Hierarchical DataBrowser

Text File | 2003-11-13 | 29KB | 904 lines

'~'A
'                       Runtime : Rntm Appearance.Incl
'                           CPU : Carbon
'                    CALL Req'd : Off
'~'B
'~Introduction
/*
     Hierarchical DataBrowser demo shows how to create a hierarchical
     list for the DataBrowser control.

     If you are unfamiliar with that versatile control, go read the
     introduction found in the Simple DataBrowser demo file, the
     following will assume that you have read it already.

     This demo is based on the above mentioned introduction and
     it will add the hierarchical navigation within the list of
     items displayed in the DataBrowser.
     In order to build our hierarchy we will perform a recursive
     scan of the folder chosen by the end-user.

'~Building the hierarchy

     Obviously, the program must keep track of the item hierarchy,
     that's why we will introduce another field in our custom
     ItemRecord to hold the itemID of the parent item, said otherwise
     the folder in which the item found is located.
     We will also introduce another global variable that will help
     for counting the items during the recursive search.

     The demo below adds also two new columns that will display the
     creator code and the file type of the items found.

'~Displaying the hiearchical list

     There are three steps to follow in order to get the things
     going:

     1) Setting the disclosure column
'~'9
        The fist step is to decide which column must contain the
        disclosure triangle. Notice that you can dynamically
        change that setting. This is done like so (propertyID
        being the custom identifier for the column):

     err = FN SetDataBrowserListViewDisclosureColumn( browser, propertyID, _false )


     2) Setting the container property
'~'9
        You must let the DataBrowser know which items are meant
        to become containers that will possibly own subitems.
        This is done when the DataBrowser asks you for information
        within the GetSetItemData callback procedure. In the
        DataBrowserPropertyID parameter that usually contains
        the column identifier, the DataBrowser will pass the value
        _kDataBrowserItemIsContainerProperty asking you if the
        item under examination is a container or not. You must
        answer with a boolean value using the following function:

     err = FN SetDataBrowserItemDataBooleanValue( itemData, _true )


     3) Showing the subitems
'~'9
        The last step involves another callback procedure that you
        must install at the same time as your GetSetItemData callback,
        that is right after the creation of the DataBrowser control.
        This new procedure is called ItemNotification callback.
        The DataBrowser will call that routine each time something
        happens that might interest you, typically when the end-user
        interacts with the items in the list.
        A few parameters are sent to the routine: the browser that
        notifies your program, the itemID of the concerned item and
        a value indicating which event is reported. The message that
        is relevant for our purpose here, is: _kDataBrowserContainerOpened
        which indicates that the end-user has played with the disclosure
        triangle to unfold the container's content. Finally, it
        indicates for you that it is time to add the subitems with
        the ordinary AddDataBrowserItems function like so:

     err = FN AddDataBrowserItems( browser,containerItemID, subItemCount, @arrayOfSubItemIDs(0), _kDataBrowserItemNoProperty )

        It is to note that the subitems are destroyed every time
        a container item is closed.

     To explore further the DataBrowser features (like drag & drop,
     contextual menu, help tags, etc.) see the demo Basic DataBrowser.


                                                            Alain   May 2003
*/
'~'6

Include "Tlbx ControlDefinitions.Incl"

Include "Util_Files.incl"
Include "Tlbx Icons.Incl"

'~Toolbox Added Declarations

_kWindowInWindowMenuAttribute  = (1 << 27 )
_kControlDataBrowserPart       = 24

Toolbox Fn SetAutomaticControlDragTrackingEnabledForWindow( WindowRef inWindow, Boolean inTracks) = OSStatus
Toolbox Fn CFAllocatorGetDefault = CFAllocatorRef

'~Application Constants

Begin Enum
_mainWnd         = 1

_myCreator       = _"DEMO"
_myDataBrowser   = _"Brsr"

_nameColumnID    = _"name"
_typeColumnID    = _"type"
_creatorColumnID = _"crea"

_scrollBarWidth  = 16
End Enum

_menuFile = 1
Begin Enum 1
_itemOpenFolder
_
_itemQuit
End Enum

'~Application Globals

Begin Record ItemRecord
Dim itemID   As Long
Dim parent   As Long
Dim spec     As FSSpec
Dim type     As OSType
Dim creator  As OSType
Dim dataLen  As Long
Dim rsrcLen  As Long
Dim cDate    As Long
Dim mDate    As Long
Dim flags    As Short
Dim attrib   As Short
End Record


Begin Globals

Dim As Long       gFileIndex
Dim Dynamic       gFiles(_maxInt) As ItemRecord

End Globals


'~';
'~-
'~Utility Functions
/*
     Handy function that returns the maximum index in a dynamic array
*/
Def Fn UBound(@P As ptr) = [P + _AutoXREFCurr] - 1

'~'1
/*
     This function returns the iconRef for a given file
*/
Clear Local Mode
Local Fn GetFileIcon( fSpec As .FSSpec, type As OSType )
'~'9
Dim @ iconH As IconRef
Dim @ label As Int
Dim   err   As OSErr

If fSpec Then err = Fn GetIconRefFromFile( #fSpec, iconH, label )
Long If err != _noErr Or iconH = _nil
Select type
Case _"APPL" : type = _kGenericApplicationIcon
Case _"fldr" : type = _kGenericFolderIcon
Case else    : type = _kGenericDocumentIcon
End Select
err = Fn GetIconRef( _kOnSystemDisk, _kSystemIconsCreator, type, iconH )
End If

End Fn = iconH


/*
     GetFolderDirID returns the dirID of a folder given its FSSpec
*/
Clear Local Mode
Local Fn GetFolderDirID( fldSpec As .FSSpec, canCreateFolder As Boolean )
'~'9
Dim @ dirID As Long
Dim   fld   As FSSpec
Dim   pb.108 //CInfoPBRec

Select Fn FSMakeFSSpec( fldSpec.vRefNum, fldSpec.parID, fldSpec.name, fld )
Case _noErr
pb.ioNamePtr&   = @fldSpec.name
pb.ioVRefNum%   = fldSpec.vRefNum
pb.ioDirID&     = fldSpec.parID
If Fn PBGetCatInfoSync( pb ) then Exit Fn
dirID = pb.ioDirID&

Case _fnfErr
Long If canCreateFolder != _kDontCreateFolder
Long If Fn FSpDirCreate( fld, _smCurrentScript, dirID ) != _noErr
Exit Fn
End If
End If
End Select

End Fn = dirID


'~--
'~Application Functions

'~'1
/*
     This function retrieves the browser reference from the window
     in which it is located.
     The browser reference has been saved has a window property.
     You can store private properties with user interface elements
     as your liking and retrieve them when you need them.
*/
Clear Local
Local Fn GetDataBrowserFromWindow( wRef As WindowRef )
'~'9

Dim As OSStatus     err
Dim As ControlRef @ browser

Long If wRef
err = Fn GetWindowProperty( wRef, _myCreator, _myDataBrowser, Sizeof(browser), #_nil, browser )
End If

End Fn = browser



'~';
/*
     This function will resize the DataBrowser when needed,
     for example, when the window is resized.
*/
Clear Local Fn RefreshDataBrowser( wNum As Long )
'~'9
Dim As Rect         r
Dim As WindowRef  @ wRef
Dim As ControlRef   browser

Get Window wNum, wRef
Long If wRef
Long If Fn GetWindowBounds( wRef, _kWindowContentRgn, r ) = _noErr
browser = Fn GetDataBrowserFromWindow( wRef )
Long If browser
SizeControl( browser, r.right - r.left, r.bottom - r.top)
End If
End If
End If

End Fn


/*
     This function empties the DataBrowser
*/
Clear Local
Local Fn ClearDataBrowser
'~'9

Dim As ControlRef   browser
Dim As Handle       arrayOfItemID
Dim As OSStatus     err

browser = Fn GetDataBrowserFromWindow( Window( _wndRef ) )
If browser == _nil then Exit Fn
/*
     Below is another way to get all the itemIDs removed from the
     DataBrowser list.
     We ask first the DataBrowser to provide a flatten list of all the itemIDs
     it contains. It will return that list in an handle that we must
     supply (as an empty handle). The parmeter set to true in the
     GetDataBrowserItems function means a recursive search.
     On return we can use that list to remove all the itemIDs at once.
*/
arrayOfItemID = Fn NewHandle( 0 )
Long If arrayOfItemID
err = Fn GetDataBrowserItems ( browser, _kDataBrowserNoItem, _true , _kDataBrowserItemAnyState, arrayOfItemID )
Long If err = _noErr
err = Fn RemoveDataBrowserItems ( browser,0, Fn GetHandleSize(arrayOfItemID)\\ Sizeof(DataBrowserItemID), #[arrayOfItemID], _nil)
End If
DisposeHandle( arrayOfItemID )// free the memory used
End If

End Fn


/*
     This function installs the itemIDs in the DataBrowser control
*/
Clear Local
Local Fn FillDataBrowser
'~'9
Dim As ControlRef           browser
Dim As OSStatus             err
Dim As Long                 numberOfItems, u
Dim As Handle               arrayOfItemID

browser = Fn GetDataBrowserFromWindow( Window( _wndRef ) )// retrieve the browser from the window property
If browser == _nil then Exit Fn

numberOfItems = Fn UBound(gFiles)// retrieve the maximum index of our dynamic array
If numberOfItems = 0 then Exit Fn// no items we can leave

arrayOfItemID = Fn NewHandle( 0 )// prepare the array (we will use here a handle)

For u = 2 To numberOfItems// we skip index 1 (which is the folder chosen by the end user)
Long If gFiles.parent(u) = gFiles.itemID(1)// we will include only the items that belong to the master folder
Long If Fn PtrAndHand( @gFiles.ItemID(u), arrayOfItemID, Sizeof(DataBrowserItemID) ) != _noErr
DisposeHandle( arrayOfItemID ) : Exit Fn// leave the fn on error
End If
End If
Next

err = Fn AddDataBrowserItems( browser, _kDataBrowserNoItem, Fn GetHandleSize(arrayOfItemID)\\ Sizeof(DataBrowserItemID), #[arrayOfItemID], _kDataBrowserItemNoProperty )
DisposeHandle( arrayOfItemID )// free the memory used
// make sure our itemID 2 (actually our first item in the list) is visible on screen
err = Fn RevealDataBrowserItem ( browser, 2, _nameColumnID, _kDataBrowserRevealWithoutSelecting )

End Fn

'~'1
/*
     This function scans the folder specified by its FSSpec.
     As it calls itself for a recursive search, an index is used
     to keep track of who was calling the function (parentFolder)
*/
Clear Local Fn CollectFileItems ( fSpec As .FSSpec, parentFolder As Long )
'~'9

Dim As Short  Index, Err
Dim As FSSpec tpSpec
Dim           pb.128

#If Ndef _kFolderBit
_kFolderBit = 3
#Endif

Index = 1// start at index 1

Do

pb.ioFDirIndex%  = Index// fill the param block
pb.ioNamePtr&    = @fSpec.name// the folder requested
pb.ioVRefNum%    = fSpec.vRefNum
pb.ioDirID&      = fSpec.parID

If Fn PBGetCatInfoSync( pb ) then Exit Do// leave the loop on error


Long If ( pb.ioFlUsrWds.fdFlags% And _fInvisible ) = _false// skip invisible items
gFileIndex++// we've got one more item to add to our list
gFiles.itemID(gFileIndex) = gFileIndex// this index will become our DataBrowser itemID
gFiles.parent(gFileIndex) = parentFolder// store the parent folder index in the item structure
gFiles.spec  (gFileIndex) = fSpec// save the item FSSpec

Long If Fn BitTst (pb.ioFlAttrib%, _kFolderBit)// Is it a folder?
 // it's a folder...
gFiles.type   (gFileIndex)  = _"fldr"// set the file type
gFiles.creator(gFileIndex)  = _"----"// set the creator code

tpSpec.vRefNum = pb.ioVRefNum%// fill a temporary FSSpec structure
tpSpec.parID   = pb.ioDirID&// store the dirID of the parent folder in the structure...
tpSpec.parID   = Fn GetFolderDirID( fSpec, _kDontCreateFolder )// to convert it to the dirID of the new folder we want to scan

Fn CollectFileItems( tpSpec, gFileIndex )// start another round with that folder

xelse// it is a file...

gFiles.type   (gFileIndex) = pb.ioFlUsrWds.fdType&// grab the info from the param block
gFiles.creator(gFileIndex) = pb.ioFlUsrWds.fdCreator&
gFiles.flags  (gFileIndex) = pb.ioFlUsrWds.fdFlags%
gFiles.dataLen(gFileIndex) = pb.ioFlLgLen&
gFiles.rsrcLen(gFileIndex) = pb.ioFlRLgLen&
gFiles.cDate  (gFileIndex) = pb.ioFlCrDat&
gFiles.mDate  (gFileIndex) = pb.ioFlMdDat&
gFiles.attrib (gFileIndex) = pb.ioFlAttrib%
End If

End If

index++// next file or folder in the current folder

Until _nil

End Fn


'~-----
'~DataBrowser Setting & Getting Data
'~'1
/*
     This function is called via a callback procedure. This is
     the only required routine to work with a DataBrowser control.
     The DataBrowser asks you to setup some values for the cells
     that it must display. Those values are set with specific functions
     depending on the type of the cell to be updated.
     With the same callback routine the DataBrowser may inform you
     that a cell has been changed by the end user, so it is time
     to get the value sent by the DataBrowser to update your
     internal information.
*/
Clear Local Fn MyGetSetItemData( browser As ControlRef, itemID As DataBrowserItemID, columnPropID As DataBrowserPropertyID, itemData As DataBrowserItemDataRef, userChangedItemData As Boolean )
'~'9
Dim As OSStatus    err
Dim As CFStringRef txt
Dim As IconRef     iconH
Dim As FSSpec      fSpec : fSpec = gFiles.spec(itemID)// copy info from the dynamic array...
Dim As OSType      fType : fType = gFiles.type(itemID)// ... in local variables
Dim As OSType      fCrea : fCrea = gFiles.creator(ItemID)

err = _noErr

Long If userChangedItemData = _false

Select columnPropID

Case _nameColumnID' names and icons

iconH = Fn GetFileIcon( fSpec, ftype )
Long If iconH
err = Fn SetDataBrowserItemDataIcon( itemData, iconH )
err = Fn ReleaseIconRef(iconH)
End If

txt = Fn CFStringCreateWithPascalString( Fn CFAllocatorGetDefault, fSpec.name, _kCFStringEncodingMacRoman )
err = Fn SetDataBrowserItemDataText( itemData, txt ) : CFRelease( txt )

Case _typeColumnID, _creatorColumnID// file type and creator code columns

Long If fType != _"fldr"// skip folders
Select columnPropID
Case _typeColumnID    : txt = fType// deal with Type column
Case _creatorColumnID : txt = fCrea// deal with Creator column
Case else             : txt = 0
End Select
txt = Fn CFStringCreateWithPascalString( Fn CFAllocatorGetDefault, mki$(txt), _kCFStringEncodingMacRoman )
err = Fn SetDataBrowserItemDataText( itemData, txt ) : CFRelease( txt )
End If

Case _kDataBrowserItemIsContainerProperty// is that item a container?

err = Fn SetDataBrowserItemDataBooleanValue( itemData, (fType = _"fldr") )// answer true if the item is a folder

Case else:

err = _errDataBrowserPropertyNotSupported

End Select

xelse
/*
     The end user has altered the cell if we come here.
     For testing with the color column
*/
err = _errDataBrowserPropertyNotSupported

End If

End Fn = err


/*
     This function called by the ItemNotification callback procedure
     will receive some interesting message coming from the DataBrowser.
     For our purpose, we are interested to know when a container is
     opened so that we can add the appropriate subItems.
*/
Clear Local Fn MyItemNotification( browser As ControlRef, itemID As DataBrowserItemID, message As DataBrowserItemNotification )
'~'9
Dim As OSStatus            err
Dim As UInt32              i, numItems
Dim As DataBrowserItemID @ childItemID
Dim As Handle              subItems

Select message

Case _kDataBrowserContainerOpened:// a container has been opened

subItems = Fn NewHandle( 0 )// we will prepare our array of subItems in a handle
If subItems = _nil then Exit Fn

numItems = Fn UBound(gFiles)// retrieve the item count in our dynamic array
/*
     Below we start the loop at 2 'cos we don't use index 0 for our
     dynamic array, neither index 1 since the latter is reserved for
     the folder chosen by the end-user and we don't want it to appear
     in the list.
*/
For i = 2 To numItems
Long If gFiles.parent(i) = itemID// if the parent itemID of that item is the itemID of the opened container
childItemID = gFiles.itemID(i)// we can append that item (its itemID) to our list
Long If Fn PtrAndHand( @childItemID, subItems, Sizeof(DataBrowserItemID) ) != _noErr
DisposeHandle( subItems ) : subItems = _nil : Exit Fn// clean up the memory if an error occurs
End If
End If
Next

HLock( subItems )// now we can add the itemIDs in the DataBrowser control
err = Fn AddDataBrowserItems( browser, itemID, Fn GetHandleSize( subItems ) \\ Sizeof(DataBrowserItemID) , #[subItems], _kDataBrowserOrderDecreasing )
HUnlock( subItems )
DisposeHandle( subItems )

Case _kDataBrowserSelectionSetChanged:

End Select

End Fn

'~-------
'~DataBrowser Installing
'~';
/*
     This function creates the DataBrowser. It will
     size the DataBrowser control to match the content
     area of the window, then remove the automatic
     focus ring of the DataBrowser.
*/
Clear Local Fn CreateDataBrowser( wRef As WindowRef )
'~'9
Dim As Rect         r
Dim As ControlRef @ browser
Dim As Boolean    @ frameAndFocus

Long If Fn GetWindowBounds( wRef, _kWindowContentRgn, r ) = _noErr
OffsetRect( r, -r.left, -r.top )
Long If Fn CreateDataBrowserControl( wRef, r, _kDataBrowserListView, browser ) = _noErr
// Turn off DB's focus frame
Long If Fn SetControlData( browser, _kControlNoPart, _kControlDataBrowserIncludesFrameAndFocusTag, Sizeof(frameAndFocus), frameAndFocus )
End If
End If
End If

End Fn = browser

'~';
/*
     This function sets all the callback procedures that the DataBrowser
     will use in this demo to communicate with the program.
     There is a bunch of  callback routines available for the customization
     of the DataBrowser control. Here, we use the only two which are
     required to display a hierarchical list.
*/
Clear Local Fn InstallDataBrowserCallbacks( browser As ControlRef )
'~'9
Dim As OSStatus               err
Dim As DataBrowserCallbacks @ myCallbacks

myCallbacks.version = _kDataBrowserLatestCallbacks//Use latest layout and callback signatures

err = Fn InitDataBrowserCallbacks( myCallbacks )
myCallbacks.u.itemDataCallback         = Fn NewDataBrowserItemDataUPP         ( [Proc "GetSetItemDataProc"   + _FBprocToProcPtrOffset] )
myCallbacks.u.itemNotificationCallback = Fn NewDataBrowserItemNotificationUPP ( [Proc "ItemNotificationProc" + _FBprocToProcPtrOffset] )
err = Fn SetDataBrowserCallbacks( browser, myCallbacks )

End Fn


/*
     The two functions below iare meant to simplify
     the code, allowing to avoid cumbersome statements
*/
'~'1

/*
     After creating the DataBrowser, you need to configure it.
     That is to say to define columns and their properties.
     Here are the column property types you can use:

          constant names                 cell's contents are set with
     _kDataBrowserCustomType        No associated data (must use custom callbacks)
     _kDataBrowserIconType          IconRef, IconTransformType, RGBColor
     _kDataBrowserTextType          CFStringRef
     _kDataBrowserDateTimeType      DateTime or LongDateTime
     _kDataBrowserSliderType        Min, Max, Value
     _kDataBrowserCheckboxType      ThemeButtonValue
     _kDataBrowserProgressBarType   Min, Max, Value
     _kDataBrowserRelevanceRankType Min, Max, Value
     _kDataBrowserPopupMenuType     MenuRef, Value
     _kDataBrowserIconAndTextType   IconRef, CFStringRef, etc

*/
Clear Local Mode
Local Fn SetupColumn(        column As .DataBrowserListViewColumnDesc, ┬
                        columnID As UInt32, ┬
                  columnProperty As DataBrowserPropertyType, ┬
                     columnTitle As Str255, ┬
                     columnFlags As DataBrowserPropertyFlags, ┬
                   headerContent As SInt16, ┬
                        minWidth As UInt16, ┬
                        maxWidth As UInt16 )
'~'9

column.propertyDesc.propertyID    = columnID
column.propertyDesc.propertyType  = columnProperty
column.propertyDesc.propertyFlags = columnFlags

column.headerBtnDesc.btnContentInfo.contentType = headerContent
column.headerBtnDesc.minimumWidth               = minWidth
column.headerBtnDesc.maximumWidth               = maxWidth
column.headerBtnDesc.titleString = Fn CFStringCreateWithPascalString( Fn CFAllocatorGetDefault, columnTitle, _kCFStringEncodingMacRoman )

End Fn


'~'9
/*
     SetupColumnHeaderStyle( column, font, size, face, mode,just )

     column     : a column descriptor

     font       : font ID used in the header button or the old contants:
                    _sysfont    _london       _times
                    _applfont   _athens       _helvetica
                    _newyork    _sanfran      _courier
                    _geneva     _toronto      _symbol
                    _monaco     _cairo        _mobile
                    _venice     _losangeles   _apfontid

     size      : font size in pixels

     face      : font style. Use the following constants:
                    _boldBit%    _ulineBit%    _shadowBit%
                    _italicBit%  _outlineBit%  _condenseBit%

     mode      : transfer mode. Try:
                    _srcCopy       _notSrcCopy  _patCopy  _notPatCopy
                    _srcOr         _notSrcOr    _patOr    _notPatOr
                    _srcXor        _notSrcXor   _patXor   _notPatXor
                    _srcBic        _notSrcBic   _patBic   _notPatBic
                    _hilite        _blend
                    _addPin        _addOver
                    _subPin        _addMax
                    _adMax         _subOver
                    _adMin         _ditherCopy
                    _transparent   _grayishTextOr
                    _hilitetransfermode

     just     : text justification. Use:
                    _teJustLeft     _teFlushDefault
                    _teJustCenter   _teCenter
                    _teJustRight    _teFlushRight
                    _teForceLeft    _teFlushLeft
*/

Clear Local Mode
Local Fn SetupColumnHeaderStyle( column As ^DataBrowserListViewColumnDesc, ┬
                               font As Short, ┬
                               size As Short, ┬
                               face As Short, ┬
                               mode As Short, ┬
                               just As Short )
'~'9
Dim colStyle As ControlFontStyleRec

colStyle = column.headerBtnDesc.btnFontStyle
If font then colStyle.flags = colStyle.flags Or _kControlUseFontMask : colStyle.font  = font
If size then colStyle.flags = colStyle.flags Or _kControlUseSizeMask : colStyle.size  = size
If face then colStyle.flags = colStyle.flags Or _kControlUseFaceMask : colStyle.style = face
If mode then colStyle.flags = colStyle.flags Or _kControlUseModeMask : colStyle.Mode  = mode
If just then colStyle.flags = colStyle.flags Or _kControlUseJustMask : colStyle.just  = just
BlockMoveData( @colStyle, @column.headerBtnDesc.btnFontStyle, Sizeof(ControlFontStyleRec) )
End Fn


/*
     This function will add the columns in the DataBrowser control
*/
Clear Local Fn ConfigureDataBrowser( browser As ControlRef )
'~'9
Dim As OSStatus                       err
Dim As DataBrowserListViewColumnDesc  col
Dim As DataBrowserViewStyle         @ viewStyle

err = Fn GetDataBrowserViewStyle( browser, viewStyle )

Select viewStyle

Case _kDataBrowserListView:

col.headerBtnDesc.titleOffset = 0
col.headerBtnDesc.version     = _kDataBrowserListViewLatestHeaderDesc

/*
     Two custom functions for easy setup

     fn SetupColumn( columnDescriptor,┬
                             columnID, ┬
                       columnProperty, ┬
                          columnTitle, ┬
                          columnFlags, ┬
                        headerContent, ┬
                             minWidth, ┬
                             maxWidth )

     fn SetupColumnHeaderStyle( columnDescriptor, fontID, textSize, textFace, textMode,justification )
*/

// ------- Add the name & icon column -------
Fn SetupColumn(          col, ┬
               _nameColumnID, ┬
_kDataBrowserIconAndTextType, ┬
                       "Name",┬
_kDataBrowserListViewSelectionColumn_kDataBrowserListViewDefaultColumnFlags, ┬
    _kControlContentTextOnly, ┬
                      0 ,280 )
Fn SetupColumnHeaderStyle( col, 0, 0, 0, 0, _teFlushDefault )
err = Fn AddDataBrowserListViewColumn( browser, col, _kDataBrowserListViewAppendColumn )

// ------- Add the Creator Code column -------
Fn SetupColumn(      col, ┬
        _creatorColumnID, ┬
   _kDataBrowserTextType, ┬
               "Creator", ┬
_kDataBrowserListViewSelectionColumn _kDataBrowserListViewDefaultColumnFlags, ┬
_kControlContentTextOnly, ┬
                    0 ,150 )
Fn SetupColumnHeaderStyle( col, 0, 0, 0, 0, _teCenter )
err = Fn AddDataBrowserListViewColumn( browser, col, _kDataBrowserListViewAppendColumn )

// ------- Add the File Type column -------
Fn SetupColumn(     col, ┬
          _typeColumnID, ┬
  _kDataBrowserTextType, ┬
                 "Type", ┬
_kDataBrowserListViewSelectionColumn_kDataBrowserListViewDefaultColumnFlags, ┬
_kControlContentTextOnly, ┬
                  0 ,150 )
err = Fn AddDataBrowserListViewColumn( browser, col, _kDataBrowserListViewAppendColumn)

// setup the disclosure column
err = Fn SetDataBrowserListViewDisclosureColumn( browser, _nameColumnID, _false )

Case _kDataBrowserColumnView:

End Select

End Fn

'~';
'~----
'~Event Handling
'~'1
/*
    This function is called via a menu Item.
*/
Local Fn doOpenFolder
'~'9

Dim As int    err
Dim As FSSpec fSpec
Dim As Str255 name

Long If Len( Files$( _FSSpecFolder, "Choose a folder",,fSpec ) )// select folder dialog
Fn ClearDataBrowser// not cancelled, so clear the DataBrowser's content
Kill Dynamic gFiles// dispose of the current dynamic array
// set info for the first item (we won't display it)
gFileIndex = 1// this will be our first item
gFiles.itemID (gFileIndex) = gFileIndex// first itemID
gFiles.spec   (gFileIndex) = fSpec// copy the selected FSSpec
gFiles.type   (gFileIndex) = _"fldr"// give a type
gFiles.creator(gFileIndex) = _"----"// and a creator to that item
err = Usr FSGetFolderName( fSpec, name )// retrieve the folder name since folder FSSpecs have an empty name
gFiles.spec.name(gFileIndex) = name// store it in our item structure
Window _mainWnd, name// update window title
Fn CollectFileItems( fSpec, gFileIndex )// collect files and folders
Compress Dynamic gFiles// optimize memory
Fn FillDataBrowser// create the DataBrowser items with the grabbed info
End If

End Fn

/*
     Cheap menu handler
*/
Local Fn doMenu
'~'9
Dim As Short menuID, itemID

menuID = Menu( _menuID )
itemID = Menu( _ItemID )

Select menuID
Case _menuFile
Select itemID
Case _itemOpenFolder : Fn doOpenFolder
Case _itemQuit       : End
End Select
End Select

Menu

End Fn


/*
     Minimalist dialog handler
*/
Local Fn doDialog
'~'9
Dim As Long act, ref

act = Dialog(0)
ref = Dialog(act)

Select act
Case _wndZoomIn, _wndZoomOut,_wndResized
Fn RefreshDataBrowser( ref )
Case _wndClose : End
End Select

End Fn

'~';
'~------
'~Main Program
'~';
/*
     This function installs our cheap menu, a window
     and a DataBrowser control in that window.
     It runs the main event loop too.
*/
Clear Local Fn StartProgram
'~'9
Dim As OSStatus        err
Dim As Rect            r
Dim As WindowRef     @ wRef
Dim As ControlRef    @ browser

// Setup a menu
Menu _menuFile,  0             , _enable, "File"
Menu _menuFile, _itemOpenFolder, _enable, "Open Folder/O"
Menu _menuFile, _itemQuit      , _enable, "Quit/Q"

// Setup a window
SetRect( r, 100, 100, 600, 400 )
Appearance Window - _mainWnd, "Hierarchical DataBrowser", @r ,_kDocumentWindowClass, ┬
                    _kWindowInWindowMenuAttribute _kWindowStandardDocumentAttributes

wRef = Window( _wndRef )
err = Fn SetAutomaticControlDragTrackingEnabledForWindow( wRef, _true )

// Create the DataBrowser control
browser = Fn CreateDataBrowser( wRef )

Long If browser
Fn InstallDataBrowserCallbacks( browser )// install the callback routines
Fn ConfigureDataBrowser( browser )// Configure the DataBrowser
err = Fn SetKeyboardFocus( wRef, browser, _kControlDataBrowserPart )// Set the keyboard focus
err = Fn SetWindowProperty( wRef, _myCreator, _myDataBrowser, Sizeof(browser), browser )// Store our custom DataBrowser ID as a window property
End If

Window _mainWnd// make the window visible

On Menu   Fn doMenu
On Dialog Fn doDialog

Do
Handleevents
Until _nil

End Fn

// The start
Fn StartProgram

'~---
'~Applications Proc
/*
     Entry points for the callback procedures (will be redirected to local fns)
*/
#If Def _FBUseDebugger
Troff
#Endif

goto "skip procs"

"GetSetItemDataProc"
Enterproc Fn GetSetItemDataProc( browser As ControlRef, itemID As DataBrowserItemID, prop As DataBrowserPropertyID, itemData As DataBrowserItemDataRef, changeValue As Boolean ) = OSStatus
Exitproc = Fn MyGetSetItemData( browser, itemID, prop, itemData, changeValue )

"ItemNotificationProc"
Enterproc ItemNotificationProc( browser As ControlRef, itemID As DataBrowserItemID, message As DataBrowserItemNotification )
Fn MyItemNotification( browser, itemID, message )
Exitproc
"skip procs"

#If Def _FBUseDebugger
Tron
#Endif